COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00013 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
C	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199

	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED /SAM/ISAM,ITRUNC
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(16000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 99 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.

	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99) /COPYL/COPYL(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/16000/,NUMP/99/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/

C**** OUT FOR NOW 7/9/79 *******	TYPE 8003
C**** 8003	FORMAT(' FOR "MUS10" OUTPUT, FIRST TYPE "MUS10"'/)

C	1' NOW 99 PARAMETERS MAY BE USED.'/
C	1'     FOR RANDOM RESTS USE RR '/
C	1'         FOR RANDOM P1 DEVIATION USE RD'/)
	ISAM=-1
	ITRUNC=0
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
CC    PR=0  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
CC    TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,NUMP+2
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TY=0
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
	CALL LO2UP(K)
C  JFM IS THE CURRENT FORMAT STATEMENT
	IF(K.NE.'TRUNC')GO TO 2999
	ITRUNC=-1
	TYPE 3999
	GO TO 2112
C TRUNCATION SWITCH CONSIDERS PARAMETERS TO BE LOCAL FOR EACH INST.
3999	FORMAT(' TRUNCATION SWITCH SET (PARAMS ARE LOCAL ONLY)')
2999	IF(K.NE.'MUS10')GO TO 999
	ISAM=0 
	TYPE 1999
	GO TO 2112
C SAMSWITCH ALLOWS FOR OVERLAPS OF INSTRUMENTS AND OMITS 'PLAY' AT TOP.
1999	FORMAT(' MUS10 SWITCH HAS BEEN SET.')
999	IF(K.NE.'EDIT')GO TO 3112
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.NE.'?')GO TO 3128
1280	TYPE 8002
118	FORMAT(' TO DSK=1,11   TTY=2,22   BOTH=0,33   LPT=4'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT(' YOU MAY TYPE:  NAME  TEMPO-FAC  AMPFAC  OMIT"  DUR"'//)
1114	FORMAT('    FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
	1' N1 = 1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
	1'    = 0 WRITES ON DSK AND SCREEN.'/
	1'    = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
	1 WRITTEN ON SCREEN.'/
	1/' N2 = RAN NUM INITIALIZATION.       N3 = DO ONLY INST. #N'/
	1/' ALSO FOR N1:  N1=5(OR 55)=DURS ONLY (FOR PROOFING)
	1, =6(OR 66)=DEBUG V ARRAY'//
	1 3X' UP TO 99 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.EQ.IBLA)K=IFLNM
	CALL IFILE(23,K)
	IFLNM=K
	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
	REREAD 8001,K
	IF(K.NE.'COMME')GO TO 3000
3001	READ(23,77732)JNP
	IF(JNP(3).NE.ISEMI)GO TO 3001
	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
3000	REWIND 23
	CALL IFILE(23,IFLNM)

3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TY=0
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	SOS=-1.
	ACCEPT 300,MX,X,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	CALL LO2UP(ISLAC)
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
	IF(MX.LT.10)GO TO 8127
	MX=MX/10
	IF(MX.EQ.3)MX=0
	SOS=0
C MX=10,11,ETC.,22,ETC.(INSTEAD OF 1,2) SUPPRESSES INPUT LISTING.
8127	JOUT=5
C  5=OUTPUT TO TTY
CC	JOUT=3 DIRECT TO LPT AT COLGATE 6/74
	MZ=0
	GO TO(110,210,310,410,510,610)MX
C 0=DSK,TTY  1=DSK  2=TTY  3=0  4=LPT  5=TTY  6=TTY
310	MZ=-1
110	CALL FORNAM(ISLAC,'SCR')
	MX=-1  
	CALL READIT
410	JOUT=22
210	MZ=-1
510	CALL READIT
610	MZ=-6
	CALL READIT
      END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END